home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-13
/
fco_me.zip
/
ME.PRG
< prev
Wrap
Text File
|
1993-03-14
|
8KB
|
329 lines
*******************************************************************************
*
* ME - MiniEditor / 2.3.92
*
*******************************************************************************
* Release 1.01 / 31.07.92
*
#include data.hdr
#include colors.hdr
#include io.hdr
#include database.hdr
#include fileio.hdr
#include string.hdr
#include system.hdr
#include keys.hdr
#include error.hdr
#include warn.hdr
#include math.hdr
#include memo.hdr
#include date.hdr
#include tsr.hdr
*******************************************************************************
*
* Defines
*
*******************************************************************************
#define vers "1.01"
*******************************************************************************
*
* Database strukture
*
*******************************************************************************
DBFDEF ME
MEMO text
ENDDEF
*******************************************************************************
*
* Global Variables
*
*******************************************************************************
VARDEF
CHAR(80) temp_path
CHAR(80) me_dbf
INT msg_color = &green_black
INT std_color = &blue_light_cyan
UINT ax, bx, cx, dx, si, di, bp, ds, es
UINT old_cursor
FILE f
CHAR(128) datei
CHAR(128) dateiname
CHAR(255) line
LOGICAL insert
ENDDEF
*******************************************************************************
*
* Allgemeine Funktionen
*
*******************************************************************************
*--- Laufzeitfehler ausgeben und Programm korrekt beenden
*
PROCEDURE error_proc
set color to
?
?
?? chr(7)
@10, 5 ?? "Laufzeitfehler:",trim(i_str(__errcode))+", "+e_message()
@11, 5 ?? " Datenbank:",dbf()
@12, 5 ?? " Record:",i_str(recno())
@13, 0
cursor_on
quit
ENDPRO
*--- Shift Status anzeigen
*
PROCEDURE shift_status
PARAMETERS CONST logical x
VARDEF
INT r, c, oldcolor
ENDDEF
IF lastkey() = &K_INS .or. x
oldcolor = __color_std
r = row()
c = col()
__color_std = msg_color
ax = 0x0200
Interrupt(0x16, ax, bx, cx, dx, si, di, bp, ds, es)
IF bittest( ax,7 )
insert = .t.
@ 0,65 ?? "Einfg"
ax = 0x0100
cx = 0x010e
Interrupt(0x10, ax, bx, cx, dx, si, di, bp, ds, es)
ELSE
insert = .f.
@ 0,65 ?? space(5)
ax = 0x0100
cx = 0x0d0e
Interrupt(0x10, ax, bx, cx, dx, si, di, bp, ds, es)
ENDIF
__color_std = oldcolor
@ r, c
ENDIF
ENDPRO
*--- Alles Eingaben gehen über diese Routine
*
FUNCTION UINT keyfilter
VARDEF
UINT col, row, n
ENDDEF
do shift_status with .f.
ax = 0x0300
Interrupt(0x10, ax, bx, cx, dx, si, di, bp, ds, es)
col = dx % 256
row = dx / 256
@0,50 ?? row,col
DO CASE
CASE lastkey() = &K_F1
save_screen()
IF exist( trim(temp_path)+"me.hlp" )
clear
type( trim(temp_path)+"me.hlp" )
DO WHILE inkey() = 0
ENDDO
ELSE
?? chr(7)
ENDIF
restore_area()
RETURN &K_F1
CASE lastkey() = &K_TAB
IF insert
keyboard( space( 8-( col % 8)))
ELSE
n = 8-( col % 8 )
DO while n > 0
key_int( &K_RIGHT )
n = n - 1
ENDDO
ENDIF
ENDCASE
RETURN lastkey()
ENDPRO
*******************************************************************************
*
* Function: FCO_MAIN
* Description: Main entry point for program.
*
*
*******************************************************************************
PROCEDURE FCO_main
PARAMETERS CONST char(128) cmd_line
SET SCOREBOARD OFF
SET MESSAGE TO 24
SET INTENSITY ON
SET EXACT OFF
SET DATE GERMAN
*--- MemoBuffer setzen
__memo_max = 32768
*--- Hilfe mit F1, alle Eingaben über keyfilter
ON KEY DO keyfilter
*---setup error procedure
ON ERROR DO error_proc
*--- DOS benutzen
DO scrn_dos
DO key_dos
*--- alte Cursorform sichern
ax = 0x0300
bx = 0x000
Interrupt(0x10, ax, bx, cx, dx, si, di, bp, ds, es)
old_cursor = cx
*--- create path from current directory
temp_path = chr( curdrive() + 'A' ) + ":" + curdir( 0 )
IF right( temp_path, 1 ) <> "\"
*--- add ending backslash
temp_path = temp_path + "\"
ENDIF
me_dbf = temp_path + "ME.DBF"
*--- Farben setzen
IF .NOT. iscolor() .OR. "/mono" $ lower( cmd_line )
msg_color = &white_black
std_color = &black_white
ENDIF
IF "/mono" $ lower( cmd_line )
datei = trim( stuff( cmd_line, at( "/mono", lower( cmd_line )), 5, "" ))
ELSE
datei = trim( cmd_line )
ENDIF
DO CASE
case len( datei ) = 0
? "MiniEditor v"+&vers+" (c) 1992 by Alfred Klich"
? chr(7)+"Syntax: ME [Laufwerk:]Dateiname [/mono]"
delay(1)
quit
case filesize( datei ) > __memo_max
? chr(7)+"Datei darf maximal",;
trim( i_str( __memo_max )),"Byte groß sein"
delay(1)
quit
ENDCASE
*--- Dateiname ohne Extension sichern
dateiname = left( datei, at( ".", datei ) -1 )
*--- Datenbank neu erzeugen
IF exist( me_dbf )
erase "me.dbf"
erase "me.dbt"
ENDIF
BUILD me_dbf FROM ALIAS me
use me_dbf alias me
append blank
__color_std = std_color
clear
__color_std = msg_color
@ 0, 0 clear to 0,79
@ 0, 1 ?? "ME v"+&vers,"(c) 1992 by Alfred Klich"
@ 0,40 ?? "["+datei+"]"
@24, 0 clear to 24,79
@24, 1 ?? "F1 = Hilfe · Ctrl-W = speichern + Ende · Esc = Abbruch"
__color_std = std_color
*--- Status und Cursor anzeigen
DO shift_status with .t.
*--- Wenn Datei vorhanden, Text in Memofeld laden
*
IF exist( datei )
f_open( f, datei, &F_READ )
m_open( me->text, &MO_CREATE )
f_getln( f, line ) && 1. Zeile übergehen
m_put( me->text, line )
DO WHILE .not. f_eof( f )
f_getln( f, line )
*--- <tabs> durch <space> ersetzen
DO WHILE .T.
IF at( chr( 9 ), line ) > 0
line = stuff( line, at( chr( 9 ), line ), 1,;
space( 9 - at( chr( 9 ), line ) % 8 ))
ELSE
exit
ENDIF
ENDDO
*--- unötige leerzeichen entfernrn
m_putln( me->text, rtrim( line ))
ENDDO
f_close( f )
m_close( me->text )
*--- .TMP-Datei erstellen
copy file ( datei ) to ( dateiname + ".TMP" )
ENDIF
*--- Text im Memofeld editieren
*
m_edit( me->text, 1, 0,23,79,.F. )
*--- Text wieder in Datei zurückschreiben
*
IF lastkey() <> &K_ESC
m_open( me->text, &MO_READ )
f_open( f, datei, &MO_CREATE )
m_getln( me->text, line )
f_put( f, line )
DO WHILE .not. m_eof( me->text )
m_getln( me->text, line )
f_putln( f, rtrim( line ))
ENDDO
m_close( me->text )
f_close( f )
*--- .TMP in .BAK-Datei umbenennen
IF exist( dateiname + ".BAK" )
erase( dateiname + ".BAK" )
ENDIF
IF exist( dateiname + ".TMP" )
rename( dateiname + ".TMP" ) to ( dateiname + ".BAK" )
ENDIF
ELSE
*--- .TMP-Datei löschen
IF exist( dateiname + ".TMP" )
erase ( dateiname + ".TMP" )
ENDIF
ENDIF
*--- alte Cursorform wieder herstellen
*
ax = 0x0100
cx = old_cursor
Interrupt(0x10, ax, bx, cx, dx, si, di, bp, ds, es)
*--- Programm beenden
*
close all
set color to
clear
quit
! me list structure
ENDPRO